(require* sketch/parse/rule/util)

(defrule diamond-line
    "diamond = line, line, line, line"
    ?f1 <- (shape (name "Line") (obj ?l1))
    ?f2 <- (shape (name "Line") (obj ?l2&~?l1))
    ?f3 <- (shape (name "Line") (obj ?l3&~?l2&~?l1))
    ?f4 <- (shape (name "Line") (obj ?l4&~?l3&~?l2&~?l1))
	(test (call ShapePredicate joinsLineLine ?l1 ?l2))
	(test (call ShapePredicate joinsLineLine ?l2 ?l3))
	(test (call ShapePredicate joinsLineLine ?l3 ?l4))
  	(test (call ShapePredicate joinsLineLine ?l4 ?l1))
;    (test (call ShapePredicate equalLengthLineLine ?l1 ?l2))
;    (test (call ShapePredicate equalLengthLineLine ?l1 ?l3))
;    (test (call ShapePredicate equalLengthLineLine ?l1 ?l4))
    (test (not (call ShapePredicate horizontalLine ?l1)))
    (test (not (call ShapePredicate verticalLine ?l1)))
    (test (call ShapePredicate parallelLineLine ?l1 ?l3))
    (test (call ShapePredicate parallelLineLine ?l2 ?l4))
    (test (call ShapePredicate aboveLeftPointPoint (?l1 getCenter) (?l3 getCenter)))
    (test (call ShapePredicate belowLeftPointPoint (?l4 getCenter) (?l2 getCenter)))
    =>
    (printout "recognize diamond = line, line, line, line")
    (bind ?sh (new Diamond))
    (?sh setWidth ((?l1 getCommonPointTo ?l4) distance (?l2 getCommonPointTo ?l3)))
    (?sh setHeight ((?l1 getCommonPointTo ?l2) distance (?l3 getCommonPointTo ?l4)))
    (?sh setRefPoint (?l1 getCommonPointTo ?l2))
    (retract ?f1)
    (retract ?f2)
    (retract ?f3)
    (retract ?f4)
    (assert (shape
            (name "Diamond")
            (obj ?sh)
            (children ?l1 ?l2 ?l3 ?l4)))
    (recognize ?sh (list-children (create$ ?l1 ?l2 ?l3 ?l4))))

